home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue24 / system / ZIPPER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-02  |  3.1 KB  |  137 lines
  1. unit Zipper;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Menus, ExtCtrls, ZIP;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Open1: TMenuItem;
  14.     OpenDialog1: TOpenDialog;
  15.     Panel1: TPanel;
  16.     FileList: TListBox;
  17.     Header1: THeader;
  18.     NumFiles: TLabel;
  19.     RevSort: TCheckBox;
  20.     procedure Open1Click(Sender: TObject);
  21.     procedure FileListDrawItem(Control: TWinControl; Index: Integer;
  22.       Rect: TRect; State: TOwnerDrawState);
  23.     procedure Header1Sized(Sender: TObject; ASection, AWidth: Integer);
  24.     procedure FormResize(Sender: TObject);
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.     procedure RevSortClick(Sender: TObject);
  28.   private
  29.     { Private declarations }
  30.     zp: TZipFile;
  31.     procedure FillList;
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TForm1.FillList;
  44. var
  45.     p: String;
  46.     idx: Integer;
  47. begin
  48.     FileList.Clear;
  49.     FileList.Items.Capacity := zp.FilesCount;
  50.     FileList.Items.BeginUpdate;
  51.     
  52.     for idx := 0 to zp.FilesCount - 1 do
  53.     begin
  54.         p := zp.FileName [idx] + 'ú' + FormatDateTime ('c', zp.DateTime [idx]);
  55.         p := p + 'ú' + zp.CompressMethodName [Idx] + 'ú' + zp.PathName [Idx];
  56.         fileList.Items.AddObject (p, TObject(idx));
  57.     end;
  58.  
  59.     FileList.Items.EndUpdate;
  60.     NumFiles.Caption := 'Files in archive = ' + IntToStr (zp.FilesCount);
  61. end;
  62.  
  63. procedure TForm1.Open1Click(Sender: TObject);
  64. begin
  65.     if not OpenDialog1.Execute then Exit;
  66.     zp.ZipName := OpenDialog1.FileName;
  67.     FillList;
  68. end;
  69.  
  70. function NextSection (var Str: String): String;
  71. var
  72.     idx: Integer;
  73. begin
  74.     if Str <> '' then idx := Pos ('ú', Str) else idx := 0;
  75.     if idx = 0 then
  76.     begin
  77.         NextSection := Str;
  78.         Str := '';
  79.     end
  80.     else
  81.     begin
  82.         NextSection := Copy (Str, 1, idx - 1);
  83.         Delete (Str, 1, idx);
  84.     end;
  85. end;
  86.  
  87. procedure TForm1.FileListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  88. var
  89.     Str: String;
  90.     x, idx: Integer;
  91. begin
  92.     with FileList, FileList.Canvas, Header1 do
  93.     begin
  94.         idx := 0;
  95.         FillRect (Rect);
  96.         x := Rect.left + 3;
  97.         Str := Items [Index];
  98.         while Str <> '' do
  99.         begin
  100.             TextOut (x, Rect.top, NextSection (Str));
  101.             Inc (x, SectionWidth [idx]);
  102.             Inc (idx);
  103.         end;
  104.     end;
  105. end;
  106.  
  107. procedure TForm1.Header1Sized(Sender: TObject; ASection, AWidth: Integer);
  108. begin
  109.     FileList.Invalidate;
  110. end;
  111.  
  112. procedure TForm1.FormResize(Sender: TObject);
  113. begin
  114.     FileList.Width := Panel1.Width - 20;
  115.     Header1.Width := FileList.Width;
  116. end;
  117.  
  118. procedure TForm1.FormCreate(Sender: TObject);
  119. begin
  120.     zp := TZipFile.Create ('');
  121.     zp.SortStyle := sFullName;
  122. end;
  123.  
  124. procedure TForm1.FormDestroy(Sender: TObject);
  125. begin
  126.     zp.Free;
  127. end;
  128.  
  129. procedure TForm1.RevSortClick(Sender: TObject);
  130. begin
  131.     zp.ReverseSort := RevSort.Checked;
  132.     FillList;
  133. end;
  134.  
  135. end.
  136.  
  137.